home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / rzlabel / rzlabel.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  3KB  |  130 lines
  1. {==================================}
  2. {= RzLabel - 3D Label Component   =}
  3. {=                                =}
  4. {= Ray Konopka                    =}
  5. {= Raize Software Solutions, Inc. =}
  6. {==================================}
  7.  
  8. unit Rzlabel;
  9.  
  10. interface
  11.  
  12.   uses
  13.     SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.     Forms, Dialogs, StdCtrls;
  15.  
  16.   type
  17.     TTextStyle = ( tsNone, tsRaised, tsRecessed );
  18.  
  19.     TRzLabel = class( TLabel )
  20.     private
  21.       FTextStyle : TTextStyle;
  22.       procedure DoDrawText(var Rect: TRect; Flags: Word);
  23.     protected
  24.       procedure Paint; override;
  25.       procedure SetTextStyle( Value : TTextStyle );
  26.     public
  27.       constructor Create( AOwner : TComponent ); override;
  28.     published
  29.       property TextStyle : TTextStyle read FTextStyle
  30.                                       write SetTextStyle
  31.                                       default tsRecessed;
  32.     end;
  33.  
  34.   procedure Register;
  35.  
  36. implementation
  37.  
  38.   constructor TRzLabel.Create( AOwner : TComponent );
  39.   begin
  40.     inherited Create( AOwner );
  41.     FTextStyle := tsRecessed;
  42.   end;
  43.  
  44.  
  45.   procedure TRzLabel.SetTextStyle( Value : TTextStyle );
  46.   begin
  47.     if Value <> FTextStyle then
  48.     begin
  49.       FTextStyle := Value;
  50.       Invalidate;
  51.     end;
  52.   end; {= TRzLabel.SetTextStyle =}
  53.  
  54.  
  55.   procedure TRzLabel.DoDrawText( var Rect : TRect; Flags : Word );
  56.   var
  57.     Text       : array[ 0..255 ] of Char;
  58.     TmpRect    : TRect;
  59.     UpperColor : TColor;
  60.     LowerColor : TColor;
  61.   begin
  62.     GetTextBuf(Text, SizeOf(Text));
  63.     if ( Flags and DT_CALCRECT <> 0) and
  64.        ( ( Text[0] = #0 ) or ShowAccelChar and
  65.          ( Text[0] = '&' ) and
  66.          ( Text[1] = #0 ) ) then
  67.       StrCopy(Text, ' ');
  68.  
  69.     if not ShowAccelChar then
  70.       Flags := Flags or DT_NOPREFIX;
  71.     Canvas.Font := Font;
  72.  
  73.     UpperColor := clBtnHighlight;
  74.     LowerColor := clBtnShadow;
  75.     if FTextStyle = tsRecessed then
  76.     begin
  77.       UpperColor := clBtnShadow;
  78.       LowerColor := clBtnHighlight;
  79.     end;
  80.  
  81.     if FTextStyle in [ tsRecessed, tsRaised ] then
  82.     begin
  83.       TmpRect := Rect;
  84.       OffsetRect( TmpRect, 1, 1 );
  85.       Canvas.Font.Color := LowerColor;
  86.       DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);
  87.  
  88.       TmpRect := Rect;
  89.       OffsetRect( TmpRect, -1, -1 );
  90.       Canvas.Font.Color := UpperColor;
  91.       DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);
  92.     end;
  93.  
  94.     Canvas.Font.Color := Font.Color;
  95.     if not Enabled then
  96.       Canvas.Font.Color := clGrayText;
  97.     DrawText(Canvas.Handle, Text, StrLen(Text), Rect, Flags);
  98.   end; {= TRzLabel.DoDrawText =}
  99.  
  100.  
  101.   procedure TRzLabel.Paint;
  102.   const
  103.     Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  104.   var
  105.     Rect: TRect;
  106.   begin
  107.     with Canvas do
  108.     begin
  109.       if not Transparent then
  110.       begin
  111.         Brush.Color := Self.Color;
  112.         Brush.Style := bsSolid;
  113.         FillRect(ClientRect);
  114.       end;
  115.       Brush.Style := bsClear;
  116.       Rect := ClientRect;
  117.       DoDrawText( Rect, ( DT_EXPANDTABS or DT_WORDBREAK ) or
  118.                   Alignments[ Alignment ] );
  119.     end;
  120.   end; {= TRzLabel.Paint =}
  121.  
  122.  
  123.  
  124.   procedure Register;
  125.   begin
  126.     RegisterComponents( 'Raize', [ TRzLabel ] );
  127.   end;
  128.  
  129. end.
  130.